
namespace eval Path {
namespace export *
# default global variables:
variable printlevel 3

# Key functions:
proc VarSpace { space variables} {}
proc addVar { space variable } {}
proc search { path pattern block } {}
proc searchfiles { path pattern block } {}
proc expand { space block } {}

# Helper functions:
proc mk_path {path } {}
proc open_file { file } {}
proc renamefile { base from to } {}
proc rmfiles { base fname} {}
proc autopath {space {pattern "array(key)_value/"}} {}
#    set path [autopath options array(key)___value/ --drop path ]
proc parse { path { pattern "array(key)_value/"} } {}
#    foreach var [ parse $path @type/@orientation/@randomseed/@dielectric(head)] {
# or foreach var [ parse $path array(key)___value/] {}
#    upvar $var Var
#    puts "$var $Var"
#    }

# Private Helper functions for Varspace:
proc getVars { space } {}
proc getValue { space name } {}
proc setValue {space name value } {}
proc getDef { space name } {}
proc islist { var } {}
proc isarray { var } {}
proc isDependentVar { definition space } {}
proc evaluate { space definition } {}
proc parse_auto {path pattern} {}
proc parse_expression {path pattern} {}

}


#####definition for procedures#######
#mk_path
proc Path::mk_path { path } {
    variable printlevel
    set subdirs [split $path /]
    set level ""
    foreach newlevel $subdirs {
	append level $newlevel/
	if { ![file exists $level] } {
	    if { $printlevel > 1 } { puts "Making dir $level ..." }
	    exec mkdir $level
	}
    }
}
#test mk_path
#mk_path 1/2/3/9.9

#open_file 
#open a file to write, if the path does not exist, dir structures will be made
#if the file exists, the old file will be moved into file.bak
proc Path::open_file { file } {
    set dir [file dirname $file]
    mk_path $dir
    if ![file exists $file] {
	set filehandle [open $file w]
	return $filehandle
    } else {
	exec mv $file ${file}.bak
       	set filehandle [open $file w]
	return $filehandle

    }
}

#expand
proc Path::expand { space block } {
    upvar $space Space
    foreach var [getVars Space] {
	set value [getValue Space $var]
	#puts "$var: $value"
	if [islist $value] {
	    #escape [] do not treat it as a individual value
	    set escaped_value [string map {\[ \{\{\#} $value]
            set escaped_value [string map {\] \#\}\}} $escaped_value]
	    foreach choice $escaped_value {
	        set choice [string map {"\{\#" "\["} $choice]
	        set choice [string map {"\{\[" "\["} $choice]
	        set choice [string map {"\#\}" \]} $choice]
	        set choice [string map {"\]\}" \]} $choice]
		setValue Space $var $choice
		expand Space $block
		setValue Space $var [getDef Space $var]
	    }
	    return
	} 
    }
    foreach var [getVars Space] {
	if [isDependentVar [getDef Space $var] Space ] {
#	    puts "evalulating dependent $var"
	    setValue Space $var [evaluate Space $var [getDef Space $var]]
	    continue
	}
	if [isExpression [getDef Space $var] ] {
#	     puts "evalulating expression $var"
	    setValue Space $var [evaluate Space $var [getValue Space $var]]
	    continue
	}
    }
    set lvl [info level ]
    set nlvl 0
    for { set i 0 } { $i < $lvl } { incr i  } {
#         puts "level $i : [info level [expr -$i]]"
	set caller [lindex [info level [expr -$i] ] 0]
	if { [string compare expand $caller ] ==0} { 
	    incr nlvl
	} else {
	    break
	}
    }
    #set Path $Path/$fname
    foreach var [getVars Space] {
	upvar $nlvl $var  Var
	set Var [getValue Space $var]
        #puts "$var $Var"
    }
    uplevel $nlvl $block
    #upspace $n Space
    #uplevel $n $block
    #restorespace $n Space
}

#VarSpace:
# define a name space that includes all the variables needed to be expanded and their dependent variables.
proc Path::VarSpace { space variables} {
    variable printlevel
    foreach varname $variables {
       uplevel 1 "Path::addVar $space $varname"
    }
}
proc Path::exists { space varname } {
   upvar $space Space
   if [info exists Space(def,$varname)] {
     return 1
   } else {
     return 0
   }
}
proc Path::addOption { space varname value } {
 upvar $space Space
 if {[lsearch $Space(def,$varname) $value] < 0 } { lappend Space(def,$varname) $value }
 if {[lsearch $Space($varname) $value] < 0 } { lappend Space($varname) $value }
}
proc Path::getVars {space } {
  upavar $space Space
  return $Space(*vars)
}
proc Path::addVar { space varname } {
        upvar $space Space
        variable printlevel
        upvar 1 $varname value
        #puts "$varname";if [array exists value] { parray value} else { puts $value}
        if ![info exists value] { error "Variable $varname do not exist!"}
        if ![isarray value] {
            if [regexp {^[\s\t]*expr} $value] { set value "\{$value\}"}
        #    if { $printlevel > 4} { puts "$varname $value"}
            set Space(def,$varname) $value
            set Space($varname) $value
            if [info exists Space(*vars)] {lappend Space(*vars) $varname } else {set Space(*vars) $varname}
        } else {
            set Space(arr_def,$varname) [array get $varname]
            foreach name [array names value] {
                set keyname ${varname}($name)
                upvar $keyname keyvalue
                if [regexp {^[\s\t]*expr} $keyvalue] { set keyvalue "\[$keyvalue\]"}
                set Space(def,$keyname) $keyvalue
                set Space($keyname) $keyvalue
                if [info exists Space(*vars)] {lappend Space(*vars) $keyname } else {set Space(*vars) $keyname}
                if { $printlevel > 4} { puts "$keyname $keyvalue"}
            }
        }
}
proc Path::getVars { space } {
    upvar $space Space
    return $Space(*vars)
}
proc Path::getArrays { space } {
    upvar $space Space
    set names {}
    foreach name [array names Space arr_def,*] {
        set name [string range $name 7 end]
        lappend names $name
    }
    return $names
}
proc Path::getValue { space name } {
    upvar $space Space
    return $Space($name)
}
proc Path::setValue {space name value } {
    upvar $space Space
    set Space($name) $value
}
proc Path::getDef { space name } {
    upvar $space Space
    if [info exists Space(def,$name)] { 
	return $Space(def,$name)
    } elseif [info exists Space(arr_def,$name) ] {
	return $Space(arr_def,$name)
    } else {
	return ""
    }
}
# check
proc Path::islist { var } {
    set var [string map {\[ \{} $var]
    set var [string map {\] \}} $var]
#    puts "$var"
#    puts "[llength $var]"
    return [expr [llength $var] -1]
}

proc Path::isarray { var } {
    upvar $var myarray
    if [array exists myarray] {
	return [llength [array names myarray]]
    }
    return 0
}

proc Path::isDependentVar { definition space } {
    upvar $space Space
    set vars [getVars Space]
    foreach var $vars {
	if {[ string first "@$var" $definition] >= 0 } { return 1 }
    }
    return 0
}
proc Path::isExpression { definition } {
    if { [regexp {\[([^\^[\]]*)\]} $definition] > 0  } { return 1 }
    return 0
}

proc Path::evaluate { space thisvar definition } {
    upvar $space Space
    set vars [getVars Space]
    set arrays [getArrays Space]
    set parsed $definition
    # change the variables from @var to their values
    set steps 0 
    while { [isDependentVar $parsed Space] } {
	foreach var $vars {
            if { [string compare $var $thisvar] == 0} { continue }
	    if { [ string first "@$var" $parsed] >=0 } {
		if [isDependentVar [getDef Space $var] Space] { 
		    set value [getDef Space $var]
		} else {
		    set value [getValue Space $var]
		}
		set parsed [string map [list @$var $value ] $parsed]
	    }
	}
      incr i
      if { $i > 20 } { error "Parsing $definition cannot proceed after $parsed! iteration too loong!"}
    }
    # 
    while { [isExpression $parsed] } {
    set parsed [subst $parsed]
    }
#    while { [regexp {\[([^\^[\]]*)\]} $parsed] > 0} {
#	regexp {\[([^\^[\]]*)\]} $parsed sub expression
#	set parsed [string map [list $sub [uplevel 1 $expression]] $parsed]
#    }
    return $parsed
}

#autopath 
proc Path::autopath {space {pattern "array(key)=value/"} args} {
    upvar $space Space
    #get the path pattern
    set equal =
    set sep /
    regexp {array\(key\)(.*)value(.*)} $pattern match equal sep
    # get the dropping option 
    set idx [lsearch $args --drop ]
    if { $idx >= 0} { set drop [lrange $args [expr $idx+1] end]} else {set drop {}}
    set str ""
    foreach var [getVars Space] {
     set def [getDef Space $var]
     set value [getValue Space $var ]
     # drop the var 
     set neglect 0
     foreach todrop $drop {
       if {[string match  "$todrop\(*\)" $var] == 1} { set neglect 1; break;}
       if {[string match $todrop $var  ] == 1} {set neglect 1; break;}
     }
     if {$neglect == 1} { continue}
     # if the defintion != value, probably have multiple value-> add to path str
     if {[string compare $def $value]!=0 && ![isDependentVar $def Space] } {
       append str $var$equal$value$sep
     }
    }
    #trim the last sep symbol
    set idx [string last $sep $str]
    set str [string range $str 0 [expr $idx-1]]
    return $str
}
#parse 
proc Path::parse_expression { path pattern} {
   foreach toescape { . * ? } {
     set pattern [string map "\\$toescape \\\\$toescape" $pattern]
   }
#   puts $pattern
   set vars [regexp -all -inline -- "\@\\w+|\@\\w+\\(\[^()\]+\\)" $pattern]
   set vars [string map {@ ""} $vars]
   set newpattern $pattern
   foreach var $vars {
   set newpattern [string map "@$var \\(\.*\\)" $newpattern]
   }
   #escape array(key)
   set newpattern [string map "\\( \\\\(" $newpattern]
   set newpattern [string map "\\) \\\\)" $newpattern]
   #but convert \(.*\) back to (.*)
   set newpattern [string map "\\\\(\\.\\*\\\\) (.*)" $newpattern]
   set values [lrange [regexp -all -inline -- $newpattern $path] 1 end]
   set nvar [llength $vars]
   set nvalues [llength $values]
   if { $nvar != $nvalues} {
    error "Somewhere went wrong!\n path: $path\npattern: $pattern\nregexp: $newpattern\nvars: $vars\nvalues: $values"
   }
   for {set i 0} {$i < $nvar} {incr i} {
    set var [lindex $vars $i]
    set value [lindex $values $i] 
    upvar 2 $var Var
    set Var $value
   }
   return $vars
}
proc Path::parse_auto { path pattern} {
    set equal =
    set sep /
    regexp {array\(key\)(.*)value(.*)} $pattern matched equal sep
    set re "(.*)${equal}(.*)$sep"
#    puts [regexp -inline -all -- $re $path]
#    get varname_value pairs
    set start 0
    set pairs {}
    foreach idx [regexp -inline -indices -all -- $sep $path] {
    set end [expr [lindex $idx 0]-1]
    lappend pairs [string range $path $start $end]
    set start [expr 1+[lindex $idx 1]]
    }
    set parsed {}
#    split into varname and value
    foreach pair $pairs {
    # if varname is a simple variable
    if [regexp -- "(\\w+)${equal}(.*)" $pair matched varname value] {
    upvar 2 $varname var
    set var $value
    lappend parsed $varname
    }
    #if varname is a array(key)
    if [regexp -- "(\\w+\\(\[^()\]+\\))${equal}(.*)" $pair matched varname value] {
    upvar 2 $varname var
    set var $value
    lappend parsed $varname
    }
    }
    return $parsed
}
proc Path::parse { path { pattern "array(key)=value/"} } {
    if {[string first @ $pattern] >= 0} { return [Path::parse_expression $path $pattern]}
    return [Path::parse_auto $path $pattern]
}


#search Path $pattern {...}
proc Path::search { path pattern block } {
    variable printlevel
    upvar $path Path
    if ![info exists Path ] {set Path "" }
    set Path [string trimright [file join [file normalize $Path] { }]]
    set base $Path
    set files [glob -nocomplain -type {f r} -path $Path $pattern]
    foreach file $files {
	set lvl [info level ]
	set nlvl 0
	for { set i 0 } { $i < $lvl } { incr i } {
	    set caller [lindex [info level [expr -$i] ] 0]
	    if { [string first search $caller ] >=0} { 
		incr nlvl
	    } else {
		break
            }
	}
	set Path $file
	uplevel $nlvl $block
	
    }
    set Path $base
    foreach dir [glob -nocomplain -type {d r} -path $Path $pattern] {
		set lvl [info level ]
	set nlvl 0
	for { set i 0 } { $i < $lvl } { incr i } {
	    set caller [lindex [info level [expr -$i] ] 0]
	    if { [string first search $caller ] >=0} { 
		incr nlvl
	    } else {
		break
            }
	}
	set Path $dir
	uplevel $nlvl $block
    }
    set Path $base
    foreach dir [glob -nocomplain $Path/*/] {
	set Path [string range $dir 0 end-1]
	search Path $pattern $block

    }
	       
}

proc Path::searchfiles { path pattern} {
    variable printlevel
    set path [string trimright [file join [file normalize $path] { }]]
    set base $path
    set files [glob -nocomplain -type {f r} -path $path $pattern]
    set path $base
    set newresults {}
    foreach dir [glob -nocomplain -type {d r } $path/*/ ] {
	set path [string range $dir 0 end-1]
        if { [string compare [file type $path] directory] !=0 } { continue }
	set newresults [concat $newresults [searchfiles $path $pattern ]] 
    }
    return [concat $files $newresults]
}
#rename 

proc Path::renamefile { base from to } {
    variable printlevel
    set path $base
    search path *$from* {
	set origin_path $path
	set to_path [ string map [list $from $to] $origin_path ]
	if {$printlevel >2} { puts "Moving $origin_path to $to_path "}
	exec mv $origin_path $to_path
    }
}

proc Path::rmfiles { base fname} {
  foreach file [searchfiles $base $fname ] {
   puts "rm $file"
   exec rm $file
  }
}
proc Path::printVarSpace { space } {
  upvar $space options
  foreach var [lsort $options(*vars)] {
     puts "$var = $options(def,$var)"
  }
}
